perm filename TREST.F4[MSS,LCS]1 blob sn#092566 filedate 1974-03-21 generic text, type T, neo UTF8
00100		SUBROUTINE TAIL(RJX,RA,RMINI)
00200		COMMON /STF/RSTFAC(8),RSTJC
00300		COMMON /PLTR/IPLT,RHT,DIS
00400		DIMENSION JARY(1),ITAIL(21)
00500	CC	IF(JARY(1).EQ.0)CALL RDDATA('TAIL',JARY,ITAIL)
00600	CC	R=ABS(RA)
00725		DATA ITAIL/9,100000040, 20036, 80030,100026,120019,120016,110012
00740		1,90007 ,12, 12, 40, 20036, 80030, 100026, 120019, 120016
00785		1,100022, 80025, 60028, 33/
00799		Q=-1.
00800		IF(RA)Q=1.
00900		CALL CENTER(RJY)
01000		CALL JDRAW(ITAIL(1),RJX,RJY,RMINI,1.,Q)
01100	1	IF(IPLT.GE.0)RETURN
01200		IF(RMINI.NE.RSTJC)Q=Q*.6
01300		CALL FILLER(ITAIL(10),RJX,RJY,ABS(Q),Q)
01400	CC	IF(IPLT)CALL FILLER(ITAIL(ITAIL(1)+2),RJX,RJY,1.,RQ)
01500	C RA=-,STEM UP;  RA=+, STEM DOWN.
01600		END
01700	
01800		SUBROUTINE REST
01900		COMMON /STF/RSTFAC(8),RSTJC
02000		COMMON /PLTR/IPLT,RHT,DIS
02100		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
02200		EQUIVALENCE(JE,JQ(3))
02300		DIMENSION LRST(4),IRST(74)
02400	
02500		IF(LRST(1).EQ.0)CALL RDDATA('REST',LRST,IRST)
02600		L=JE
02700		IF(L.GT.1)L=1
02800		K=LRST(L+3)
02900	C  L>3 WHEN SEVERAL TAILS ON REST
03000		CALL CENTER(CENTR)
03100		CALL JDRAW(IRST(K),RJB,CENTR,RSTJC,1.,1.)
03200		IF(JE.OR.IPLT.GE.0)RETURN
03300		CALL FILLER(IRST(IRST(K)+K+1),RJB,CENTR,1.,1.)
03400	C  WHY GO THROUGH NOTWRT??
03500		END
03600	
03700		SUBROUTINE RDDATA(NM,JARY,IARY)
03800	C  READS DATA 
03900		DIMENSION JARY(1),IARY(1)
04000		REWIND 23
04100		CALL IFILE(23,NM)
04200		READ(23,5)K,(JARY(K),K=1,10)
04300		N=1
04400	1	READ(23,5,END=2)K,L,(IARY(K),K=N,N+L-1)
04500		N=N+L
04600		GO TO 1
04700	2	RETURN
04800	5	FORMAT(12I)
04900		END
05000	
05100	C  FOR SINGLE (OR DOUBLE) BAR REPEAT SIGN
05200		SUBROUTINE BREP(RJB,RSTJC)
05300		DIMENSION JREP(1),IREP(35)
05325		DATA IREP/35,100000016,280043,290043, 10016, 20016, 300043,310043
05340		1,30016, 40016, 320043,100020037, 30038, 40038, 50037
05355		1,50036, 40035, 30035, 20036, 20037, 50037, 20036, 40036
05370		1,100270022,280021,290021,300022,300023,290024,280024,270023
05385		1,270022, 300022, 270023, 290023/
05400	CC	IF(JREP(1).EQ.0)CALL RDDATA('BREP',JREP,IREP)
05500		CALL CENTER(R)
05600		CALL JDRAW(IREP,RJB,R,RSTJC,1.,1.)
05700		END
05800	
05900		SUBROUTINE FERMTA(RINV)
06000		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
06100		COMMON /PLTR/IPLT,RHT,DIS
06200		COMMON /STF/RSTFAC(8),RSTJC
06300		DIMENSION JFERM(1),IFERM(39)
06400		IF(JFERM(1).EQ.0)CALL RDDATA('FERM',JFERM,IFERM)
06500	CC	R=INV
06600		CALL JDRAW(IFERM,RJB,CENTR,RSTJC,1.,RINV)
06700		IF(IPLT)CALL FILLER(IFERM(IFERM(1)+2),RJB,CENTR,1.,RINV)
06800		END
06900	
07000		SUBROUTINE EXCH(X,Y)
07100		Z=X
07200		X=Y
07300		Y=Z
07400		END
07500		SUBROUTINE SORT2(RPOS,M)
07600		DIMENSION RPOS(2,200)
07700		L=2
07800	3	J=-1
07900		RX=RPOS(1,L-1)
08000		DO 2 K=L,M
08100		IF(RPOS(1,K).GE.RX)GO TO 2
08200		RX=RPOS(1,K)
08300	C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
08400		J=K
08500	2	CONTINUE
08600		IF(J)GO TO 4
08700		K=L-1
08800		CALL EXCH(RPOS(1,K),RPOS(1,J))
08900		CALL EXCH(RPOS(2,K),RPOS(2,J))
09000	4	L=L+1
09100		IF(L.LE.M)GO TO 3
09200		END
09300